'   *****************************************

'   *******  2DFFT 13.00 - 2D XFORM   *******

'   ******* APPS 2ND EDITION - 05/03  *******

'   *****************************************

10 SCREEN 9, 1, 1: COLOR 15, 1: CLS

14 INPUT "SELECT ARRAY SIZE AS 2^N.  N ="; N

16 N1 = N - 1: Q = 2 ^ N: Q1 = Q - 1

18 ' $DYNAMIC

20 DIM C(Q, Q), S(Q, Q), KC(Q), KS(Q), DAC(Q, Q), DAS(Q, Q)

30 Q2 = Q / 2: Q3 = Q2 - 1: Q4 = Q / 4: Q5 = Q4 - 1: Q8 = Q / 8

32 PI = 3.141592653589793#: PI2 = 2 * PI: K1 = PI2 / Q: CLVK = 1

 '  **** TWIDDLE FACTOR TABLE GENERATION ****

40 FOR I = 0 TO Q: KC(I) = COS(K1 * I): KS(I) = SIN(K1 * I)

42 IF ABS(KC(I)) < .0000005 THEN KC(I) = 0 ' CLEANUP TABLE

44 IF ABS(KS(I)) < .0000005 THEN KS(I) = 0

46 NEXT I

48 FOR I = 1 TO Q1: INDX = 0

50 FOR J = 0 TO N1

52 IF I AND 2 ^ J THEN INDX = INDX + 2 ^ (N1 - J)

54 NEXT J

56 IF INDX > I THEN SWAP KC(I), KC(INDX): SWAP KS(I), KS(INDX)

58 NEXT I



70 CLS : PRINT : PRINT : PRINT "               MAIN MENU": PRINT

74 PRINT " 1 = TRANSFORM FUNCTION": PRINT

76 PRINT " 2 = INVERSE TRANSFORM ": PRINT

84 PRINT " 3 = GENERATE FUNCTIONS              ": PRINT

88 PRINT " 4 = EXIT              ": PRINT : PRINT

90 PRINT "            MAKE SELECTION";

92 A$ = INKEY$: IF A$ = "" THEN 92

94 A = VAL(A$): ON A GOSUB 100, 150, 5000, 112

96 IF A = 4 THEN 9999

98 GOTO 70



 '  **********************************************

 '  *              XFORM FUNCTION                *

 '  **********************************************

100 CLS : K6 = -1: SK1 = 2: XDIR = 1: T9 = TIMER 'XDIR: 1 = FWD, 0 = INVERSE

102 GOSUB 200 ' DO FORWARD ROW XFORMS

104 GOSUB 300 ' DO FORWARD COLUMN XFORMS

106 T9 = TIMER - T9 ' CHECK TIME

108 'GOSUB 176 ' DISPLAY DATA

110 'PRINT : INPUT "ENTER TO CONTINUE"; A$ ' WAIT

112 RETURN



 '  **********************************************

 '  *            INVERSE TRANSFORM               *

 '  **********************************************

150 CLS : K6 = 1: SK1 = 1: XDIR = 0: T9 = TIMER

152 GOSUB 300 ' RECONSTRUCT COLUMNS

153 GOSUB 200 ' RECONSTRUCT ROWS

155 T9 = TIMER - T9 ' GET TIME

156 'GOSUB 176 ' PLOT OUTPUT

158 'PRINT : INPUT "ENTER TO CONTINUE"; A$ ' WAIT

160 RETURN



 '  **********************************************

 '  *                PLOT DATA                   *

 '  **********************************************

176 CLS : AMP1 = 0 ' FIND LARGEST MAGNITUDE IN ARRAY

178     FOR I = 0 TO Q - 1

180         FOR J = 0 TO Q - 1

182              IF XDIR = 0 THEN AMP = C(I, J): GOTO 186

184              AMP = SQR(C(I, J) ^ 2 + S(I, J) ^ 2)

186              IF AMP > AMP1 THEN AMP1 = AMP

188         NEXT J

190     NEXT I

192 MAG2 = -130 / AMP1 ' SET SCALE FACTOR

194 GOSUB 6000 ' PLOT 2-D DATA

196 LOCATE 1, 1: PRINT "TIME = "; T9

198 RETURN



 '  ************************************************

 '  *              TRANSFORMS                      *

 '  ************************************************

200 CLS : KRTST = 19

202 FOR KR = 0 TO Q1 ' XFORM 2D ARRAY BY ROWS

204 'IF XDIR = 1 THEN GOSUB 400

206 PRINT USING "###_ "; KR; ' PRINT ROW BEING XFORMED

208 IF KR = KRTST THEN PRINT : KRTST = KRTST + 20' END PRINT LINE

'    ***********************************

'    * THE ROUTINE BELOW IS FOR A ROW  *

'    ***********************************

210 FOR M = 0 TO N1: QT = 2 ^ (N - M)' DO N STAGES

212 QT2 = QT / 2: QT3 = QT2 - 1: KT = 0

214 FOR J = 0 TO Q1 STEP QT: KT2 = KT + 1' DO ALL FREQUENCY SETS

216 FOR I = 0 TO QT3: J1 = I + J: K = J1 + QT2' DO ALL FREQUENCIES IN SET

    ' ROW BUTTERFLY

218 CTEMP = (C(KR, J1) + C(KR, K) * KC(KT) - K6 * S(KR, K) * KS(KT)) / SK1

220 STEMP = (S(KR, J1) + K6 * C(KR, K) * KS(KT) + S(KR, K) * KC(KT)) / SK1

222 CTEMP2 = (C(KR, J1) + C(KR, K) * KC(KT2) - K6 * S(KR, K) * KS(KT2)) / SK1

224 S(KR, K) = (S(KR, J1) + K6 * C(KR, K) * KS(KT2) + S(KR, K) * KC(KT2)) / SK1

226 C(KR, K) = CTEMP2: C(KR, J1) = CTEMP: S(KR, J1) = STEMP

228 NEXT I' ROTATE AND SUM NEXT PAIR OF COMPONENTS

230 KT = KT + 2

232 NEXT J' DO NEXT SET OF FREQUENCIES

234 NEXT M' DO NEXT STAGE

    ' BIT REVERSAL FOR ROW TRANSFORMS

236 FOR I = 1 TO Q1: INDX = 0

238 FOR J = 0 TO N1

240 IF I AND 2 ^ J THEN INDX = INDX + 2 ^ (N1 - J)

242 NEXT J

244 IF INDX > I THEN SWAP C(KR, I), C(KR, INDX): SWAP S(KR, I), S(KR, INDX)

246 NEXT I

248 'IF XDIR = 0 THEN GOSUB 400

250 NEXT KR

252 T9 = TIMER - T9: GOSUB 176' USE TO SHOW RESULTS OF ROW XFORMS

254 A$ = INKEY$: IF A$ = "" THEN 254

256 CLS : T9 = TIMER - T9: RETURN' ROW TRANSFORMS DONE



'    *************************************

'    * THE ROUTINE BELOW IS FOR COLUMNS  *

'    *************************************

300 KRTST = 19

302 FOR KR = 0 TO Q1 ' XFORM 2D ARRAY BY COLUMNS

304 'IF XDIR = 1 THEN GOSUB 410

306 PRINT USING "###_ "; KR;

308 IF KR = KRTST THEN PRINT : KRTST = KRTST + 20

310 FOR M = 0 TO N1: QT = 2 ^ (N - M)

312 QT2 = QT / 2: QT3 = QT2 - 1: KT = 0

314 FOR J = 0 TO Q1 STEP QT: KT2 = KT + 1

316 FOR I = 0 TO QT3:  J1 = I + J: K = J1 + QT2

    'COLUMN BUTTERFLYS

318 CTEMP = (C(J1, KR) + C(K, KR) * KC(KT) - K6 * S(K, KR) * KS(KT)) / SK1

320 STEMP = (S(J1, KR) + K6 * C(K, KR) * KS(KT) + S(K, KR) * KC(KT)) / SK1

322 CTEMP2 = (C(J1, KR) + C(K, KR) * KC(KT2) - K6 * S(K, KR) * KS(KT2)) / SK1

324 S(K, KR) = (S(J1, KR) + K6 * C(K, KR) * KS(KT2) + S(K, KR) * KC(KT2)) / SK1

326 C(K, KR) = CTEMP2: C(J1, KR) = CTEMP: S(J1, KR) = STEMP

328 NEXT I

330 KT = KT + 2

332 NEXT J

334 NEXT M

    'BIT REVERSAL FOR COLUMN TRANSFORMS

336 FOR I = 1 TO Q1: INDX = 0

338 FOR J = 0 TO N1

340 IF I AND 2 ^ J THEN INDX = INDX + 2 ^ (N1 - J)

342 NEXT J

344 IF INDX > I THEN SWAP C(I, KR), C(INDX, KR): SWAP S(I, KR), S(INDX, KR)

346 NEXT I

348 'IF XDIR = 0 THEN GOSUB 410

350 NEXT KR

352 IF K6 = 1 THEN XDIR = 1

354 T9 = TIMER - T9: GOSUB 176' USE TO SHOW RESULTS OF COLUMN XFORMS

356 IF K6 = 1 THEN XDIR = 0

358 A$ = INKEY$: IF A$ = "" THEN 358

360 CLS : T9 = TIMER - T9: RETURN' COLUMN TRANSFORMS DONE



' ****************************************

' *         MODIFY ROW SAMPLING          *

' ****************************************

400 FOR I = 1 TO Q1 STEP 2

402 C(KR, I) = -C(KR, I): S(KR, I) = -S(KR, I)

404 NEXT I

406 RETURN

' ****************************************

' *        MODIFY COLUMN SAMPLING        *

' ****************************************

410 FOR I = 1 TO Q1 STEP 2

412 C(I, KR) = -C(I, KR): S(I, KR) = -S(I, KR)

414 NEXT I

416 RETURN



      '  *********************************

      '  *      GENERATE FUNCTIONS       *

      '  *********************************

5000 XDIR = 0

5001 CLS : PRINT : PRINT : PRINT "               FUNCTION MENU": PRINT

5002 PRINT " 1 = GENERATE SINC^2 FUNCTION      2 = SINC FUNCTION": PRINT

5009 PRINT " 9 = EXIT:": PRINT

5010 PRINT "            MAKE SELECTION";

5012 A$ = INKEY$: IF A$ = "" THEN 5012

5014 A = VAL(A$): ON A GOTO 5030, 5500

5016 IF A = 9 THEN RETURN

5018 GOTO 5000



      '  *********************************

      '  *       SINC^2 FUNCTION         *

      '  *********************************

5030 CLS : T1 = 0: T0 = 1

5032 INPUT "WIDTH"; WDTH1 ' INPUT FINCTION SIZE

5034 IF WDTH1 = 0 THEN WDTH1 = 1 ' ZERO INVALID

5036 SKL1 = PI2 / WDTH1: MAG1 = Q ' CALC CONSTANTS

5038 FOR I = 0 TO Q - 1 '

5040 YARG = SKL1 * (I - Q2): PRINT "*";

5042 FOR J = 0 TO Q - 1

5044 XARG = SKL1 * (J - Q2)

5046 IF YARG = 0 AND XARG = 0 THEN C(I, J) = MAG1: GOTO 5052

5048 ARG = SQR(XARG ^ 2 + YARG ^ 2)

5050 C(I, J) = MAG1 * (SIN(ARG) / ARG) ^ 2: S(I, J) = 0

5052 NEXT J

5054 NEXT I

5055 MAG2 = -130 / MAG1

5056 GOSUB 6000 ' PLOT FUNCTION

5058 INPUT A$ ' WAIT

5060 RETURN



5500  '  *********************************

      '  *         SINC FUNCTION         *

      '  *********************************

5502 CLS : MAG1 = Q: T0 = 1: T1 = 0

5504 INPUT "WIDTH"; WDTH1

5506 SKL1 = PI2 / WDTH1: MAG1 = Q

5508 FOR I = 0 TO Q - 1

5510 YARG = SKL1 * (I - Q2): PRINT "*";

5512 FOR J = 0 TO Q - 1

5514 XARG = SKL1 * (J - Q2)

5516 IF YARG = 0 AND XARG = 0 THEN C(I, J) = MAG1: GOTO 5590

5518 ARG = SQR(XARG ^ 2 + YARG ^ 2)

5520 C(I, J) = MAG1 * (SIN(ARG) / ARG): S(I, J) = 0

5590 NEXT J

5592 NEXT I

5594 GOSUB 176

5596 INPUT A$

5598 RETURN



6000  '  *******************************

      '  *         PLOT DATA           *

      '  *******************************

6002 CLS ' CLEAR SCREEN AND SET SCALE FACTORS

6004 XCAL = 320 / Q: YCAL = 120 / Q: YDIS = 150: X0 = 15

6006 FOR I = 0 TO Q - 1 ' FOR ALL ROWS

6008 DISP = X0 + (Q - I) * 288 / Q ' DISPLACE ROWS FOR 3/4 VIEW

6010 PER = I / (2 * Q) ' CORRECT FOR PERSPECTIVE

6012 FOR J = 0 TO Q - 1 ' FOR EACH PIXEL IN ROW

6014 X11 = ((XCAL + PER) * J) + DISP: Y11 = ((YCAL + .3 * PER) * I) + YDIS

6016 IF XDIR = 0 THEN AMP = C(I, J) ELSE AMP = SQR(C(I, J) ^ 2 + S(I, J) ^ 2)   ' CALC "Z" AXIS

6018 AMP = MAG2 * AMP

6020 LINE (X11, Y11 + AMP)-(X11, Y11)

6022 PRESET (X11, Y11 + AMP + 1)

6024 NEXT J ' NEXT PIXEL

6026 NEXT I ' NEXT ROW

6028 RETURN ' ALL DONE

     ' *************

9999 END: STOP



